#!/usr/bin/env perl

# This program aims to provide text manipulation to compose or accompany groff
# macros. It Should neatly fit in the usual document creation pipeline.

use v5.35;
use open qw< :encoding(UTF-8) >;

# Finds the identifires .VBS and .VBE and prepends the groff dummy character
# (\&) to text that would otherwise be interpreted as a command in groff.
sub verbatim {
	my @lines = @_;
	my $vbs = 0;
	my $vbs_line;
	my @vb_lines;
	for my $idx (0 .. $#lines) {
		$_ = $lines[$idx];
		if (/^\.(VBS|CBS)/ and $vbs != 1) {
			$vbs = 1;
			$vbs_line = $idx + 1;
			next;
		}
		if (/^\.(VBE)/) {
			die sprintf("No matching .VBS for .VBE in line %d\n", $idx + 1) if $vbs == 0;
			$vbs = 0;	
		} 
		if (/^\.(CBE)/) {
			die sprintf("No matching .CBS for .CBE in line %d\n", $idx + 1) if $vbs == 0;
			$vbs = 0;	
		} 
		push @vb_lines, $idx if $vbs == 1;
	}

	die "No matching .VBE for .VBS in line $vbs_line\n" if $vbs == 1;

	foreach (@vb_lines) {
		my $idx = $_;
		$_ = $lines[$_];
		# Escape the escape sequences, so they can be properly rendered
		$lines[$idx] =~ s/\\/\\\\/g;
		# Add a dummy character to lines containing a macro or register call
		$lines[$idx] = "\\&$_" if /^\.|^'/;
	}
	return @lines;
}

# Moves the table of contents to the first page, using the .pdfswitchtopage and
# .pdfpagename macros. For more information, refer to the gropdf documentation.
sub move_toc {
	my @lines = @_;
	my @idxs = grep { $lines[$_] =~ /^\.TC/ } 0 .. $#lines;
	die "More than one TC found\n" if $#idxs > 1;
	unshift @lines, ".pdfpagename first\n";
	if (!@idxs) { # If we don't have a TOC, write it.
		push @lines, ".pdfswitchtopage first\n";
		push @lines, ".TC\n";
	} else { splice @lines, $#lines -1, 0, ".pdfswitchtopage first\n"; }
	return @lines;
}

# Without arguments, read from stdin. Otherwise, operate on passed files.
my @lines;
if ($#ARGV == -1) {
	@lines = <STDIN>
} else {
	foreach (@ARGV) {
		open my $contents, "<", $_ or die "Could not open $_ $!\n";
		push @lines, <$contents>;
	}
}
@lines = verbatim @lines;
@lines = move_toc @lines;
print @lines;
